
@example
DEFINITION MODULE SYSTEM;

  (* Gives access to system programming facilities that are probably
     non portable. *)

  (* The constants and types define underlying properties of storage *)

EXPORT QUALIFIED BITSPERLOC, LOCSPERWORD,
                 LOC, BYTE, WORD, ADDRESS, CSIZE_T, CSSIZE_T, (* 
                 Target specific data types.  *)
                 ADDADR, SUBADR, DIFADR, MAKEADR, ADR, ROTATE,
                 SHIFT, CAST, TSIZE,

                 (* Internal GM2 compiler functions *)
                 ShiftVal, ShiftLeft, ShiftRight,
                 RotateVal, RotateLeft, RotateRight,
                 THROW, TBITSIZE ;

CONST
                  (* <implementation-defined constant> ; *)
@findex BITSPERLOC (const)
  BITSPERLOC    = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
                  (* <implementation-defined constant> ; *)
@findex LOCSPERWORD (const)
  LOCSPERWORD   = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
                  (* <implementation-defined constant> ; *)
@findex LOCSPERBYTE (const)
  LOCSPERBYTE = 8 DIV BITSPERLOC ;

(* Note that the full list of system and sized datatypes include:
   LOC, WORD, BYTE, ADDRESS,

   (and the non language standard target types)

   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
   WORD16, WORD32, WORD64, BITSET8, BITSET16,
   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.

   Also note that the non-standard data types will
   move into another module in the future.  *)

(*
   All the data types and procedures below are declared internally.
   ===============================================================

TYPE
   (* Target specific data types.  *)

TYPE
  LOC; (* A system basic type. Values are the uninterpreted
          contents of the smallest addressable unit of storage *)
@findex ADDRESS (type)
  ADDRESS = POINTER TO LOC;
@findex WORD (type)
  WORD = ARRAY [0 .. LOCSPERWORD-1] OF LOC;

  (* BYTE and LOCSPERBYTE are provided if appropriate for machine *)

TYPE
@findex BYTE (type)
  BYTE = ARRAY [0 .. LOCSPERBYTE-1] OF LOC;

@findex ADDADR
PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
  (* Returns address given by (addr + offset), or may raise
     an exception if this address is not valid.
  *)

@findex SUBADR
PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
  (* Returns address given by (addr - offset), or may raise an
     exception if this address is not valid.
  *)

@findex DIFADR
PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER;
  (* Returns the difference between addresses (addr1 - addr2),
     or may raise an exception if the arguments are invalid
     or address space is non-contiguous.
  *)

@findex MAKEADR
PROCEDURE MAKEADR (high: <some type>; ...): ADDRESS;
  (* Returns an address constructed from a list of values whose
     types are implementation-defined, or may raise an
     exception if this address is not valid.

     In GNU Modula-2, MAKEADR can take any number of arguments
     which are mapped onto the type ADDRESS. The first parameter
     maps onto the high address bits and subsequent parameters map
     onto lower address bits. For example:

     a := MAKEADR(BYTE(0FEH), BYTE(0DCH), BYTE(0BAH), BYTE(098H),
                  BYTE(076H), BYTE(054H), BYTE(032H), BYTE(010H)) ;

     then the value of, a, on a 64 bit machine is: 0FEDCBA9876543210H

     The parameters do not have to be the same type, but constants
     _must_ be typed.
  *)

@findex ADR
PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
  (* Returns the address of variable v. *)

@findex ROTATE
PROCEDURE ROTATE (val: <a packedset type>;
                  num: INTEGER): <type of first parameter>;
  (* Returns a bit sequence obtained from val by rotating up/right
     or down/right by the absolute value of num.  The direction is
     down/right if the sign of num is negative, otherwise the direction
     is up/left.
  *)

@findex SHIFT
PROCEDURE SHIFT (val: <a packedset type>;
                 num: INTEGER): <type of first parameter>;
  (* Returns a bit sequence obtained from val by shifting up/left
     or down/right by the absolute value of num, introducing
     zeros as necessary.  The direction is down/right if the sign of
     num is negative, otherwise the direction is up/left.
  *)

@findex CAST
PROCEDURE CAST (<targettype>; val: <anytype>): <targettype>;
  (* CAST is a type transfer function.  Given the expression
     denoted by val, it returns a value of the type <targettype>.
     An invalid value for the target value or a
     physical address alignment problem may raise an exception.
  *)

@findex TSIZE
PROCEDURE TSIZE (<type>; ... ): CARDINAL;
  (* Returns the number of LOCS used to store a value of the
     specified <type>.   The extra parameters, if present,
     are used to distinguish variants in a variant record.
  *)

@findex THROW
PROCEDURE THROW (i: INTEGER) ;
  (*
     THROW is a GNU extension and was not part of the PIM or ISO
     standards.  It throws an exception which will be caught by the
     EXCEPT block (assuming it exists).  This is a compiler builtin
     function which interfaces to the GCC exception handling runtime
     system.
     GCC uses the term throw, hence the naming distinction between
     the GCC builtin and the Modula-2 runtime library procedure Raise.
     The later library procedure Raise will call SYSTEM.THROW after
     performing various housekeeping activities.
  *)

@findex TBITSIZE
PROCEDURE TBITSIZE (<type>) : CARDINAL ;
  (* Returns the minimum number of bits necessary to represent
     <type>.  This procedure function is only useful for determining
     the number of bits used for any type field within a packed RECORD.
     It is not particularly useful elsewhere since <type> might be
     optimized for speed, for example a BOOLEAN could occupy a WORD.
  *)
*)


(* The following procedures are invoked by GNU Modula-2 to
   shift non word set types. They are not part of ISO Modula-2
   but are used to implement the SHIFT procedure defined above. *)

(*
   ShiftVal - is a runtime procedure whose job is to implement
              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
              inline a SHIFT of a single WORD sized set and will only
              call this routine for larger sets.
*)

@findex ShiftVal
PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
                    SetSizeInBits: CARDINAL;
                    ShiftCount: INTEGER) ;


(*
   ShiftLeft - performs the shift left for a multi word set.
               This procedure might be called by the back end of
               GNU Modula-2 depending whether amount is known at
               compile time.
*)

@findex ShiftLeft
PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
                     SetSizeInBits: CARDINAL;
                     ShiftCount: CARDINAL) ;

(*
   ShiftRight - performs the shift left for a multi word set.
                This procedure might be called by the back end of
                GNU Modula-2 depending whether amount is known at
                compile time.
*)

@findex ShiftRight
PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
                     SetSizeInBits: CARDINAL;
                     ShiftCount: CARDINAL) ;


(*
   RotateVal - is a runtime procedure whose job is to implement
               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
               inline a ROTATE of a single WORD (or less)
               sized set and will only call this routine for larger
               sets.
*)

@findex RotateVal
PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
                     SetSizeInBits: CARDINAL;
                     RotateCount: INTEGER) ;


(*
   RotateLeft - performs the rotate left for a multi word set.
                This procedure might be called by the back end of
                GNU Modula-2 depending whether amount is known at
                compile time.
*)

@findex RotateLeft
PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
                      SetSizeInBits: CARDINAL;
                      RotateCount: CARDINAL) ;


(*
   RotateRight - performs the rotate right for a multi word set.
                 This procedure might be called by the back end of
                 GNU Modula-2 depending whether amount is known at
                 compile time.
*)

@findex RotateRight
PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
                       SetSizeInBits: CARDINAL;
                       RotateCount: CARDINAL) ;


END SYSTEM.
@end example
